home *** CD-ROM | disk | FTP | other *** search
/ BBS Toolkit / BBS Toolkit.iso / wildcat / wc30rec.zip / MSGUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-12  |  9KB  |  273 lines
  1. type
  2.   MsgStatusRec = record
  3.                    LowMsg,
  4.                    HighMsg,
  5.                    ActiveMsg,
  6.                    LastExtract : Word;
  7.                  end;
  8.  
  9.  
  10.   function BuildMsgKey(var Data; Key : Byte) : IsamKeyStr;
  11.   var
  12.     MsgRec : MsgHeaderType absolute Data;
  13.  
  14.   begin
  15.     case Key of
  16.       MsgNumberKey  : BuildMsgKey := WordToKey(MsgRec.MsgNumber);
  17.       MsgOrigNumKey : BuildMsgKey := PackUserName(MsgRec.From)+WordToKey(MsgRec.MsgNumber);
  18.       MsgDestNumKey : BuildMsgKey := PackUserName(MsgRec.To_)+WordToKey(MsgRec.MsgNumber);
  19.       MsgSubjectKey : BuildMsgKey := Pack6BitKeyUC(MsgRec.Subject, 19)+WordToKey(MsgRec.MsgNumber);
  20.       MsgReceiveKey : begin
  21.                         BuildMsgKey := '';
  22.                         if (FlagIsSet(MsgRec.MsgFlags, mfReceived)) then
  23.                           Exit;
  24.                         if (not FlagIsSet(MsgRec.MsgFlags, mfReceiveable)) then
  25.                           Exit;
  26.                         BuildMsgKey := PackUserName(MsgRec.To_)+WordToKey(MsgRec.MsgNumber);
  27.                       end;
  28.       MsgDeleteKey  : if (FlagIsSet(MsgRec.MsgFlags, mfDeleted)) then
  29.                         BuildMsgKey := WordToKey(MsgRec.MsgNumber)
  30.                       else
  31.                         BuildMsgKey := '';
  32.     end;
  33.   end;
  34.  
  35.  
  36.   procedure PutMsgStatusRec(MSR : MsgStatusRec);
  37.   var
  38.     LockStatus : Boolean;
  39.     MsgHeader : MsgStatusType;
  40.  
  41.   begin
  42.     with MsgHeader do
  43.       begin
  44.         Status := 0;
  45.         LowMsg := MSR.LowMsg;
  46.         HighMsg := MSR.HighMsg;
  47.         ActiveMsg := MSR.ActiveMsg;
  48.         LastExtract := MSR.LastExtract;
  49.         Len := 12;
  50.         Next := 0;
  51.       end;
  52.     LockStatus := LockBTree(dbMsg);
  53.     BtPutRec(MsgFile, StatusRecRefNr, MsgHeader, False);
  54.     if (not IsamOk) then
  55.       LogFatalError('Error writing message status record', IsamError);
  56.     if (LockStatus) then
  57.       UnLockBtree(dbMsg);
  58.   end;
  59.  
  60.  
  61.   procedure GetMsgStatusRec(var MSR : MsgStatusRec);
  62.   var
  63.     MsgHeader : MsgStatusType;
  64.  
  65.   begin
  66.     GetBtreeRec(MsgFile, StatusRecRefNr, MsgHeader);
  67.     if (not IsamOk) then
  68.       LogFatalError('Error reading message status record', IsamError);
  69.     with MsgHeader do
  70.       begin
  71.         MSR.LowMsg := LowMsg;
  72.         MSR.HighMsg := HighMsg;
  73.         MSR.ActiveMsg := ActiveMsg;
  74.         MSR.LastExtract := LastExtract;
  75.       end;
  76.   end;
  77.  
  78.  
  79.   procedure ReCalcMsgStatus;
  80.   var
  81.     TempHigh : Word;
  82.     RefNr : LongInt;
  83.     Key : IsamKeyStr;
  84.     MSR : MsgStatusRec;
  85.     LockStatus : Boolean;
  86.  
  87.   begin
  88.     LockStatus := LockBTree(dbMsg);
  89.     GetMsgStatusRec(MSR);
  90.     MSR.ActiveMsg := BtreeUsedKeys(MsgFile, MsgNumberKey) - BtreeUsedKeys(MsgFile, MsgDeleteKey);
  91.     Key := WordToKey(0);
  92.     NextDiffBtreeKey(MsgFile, MsgNumberKey, RefNr, Key);
  93.     if (IsamOk) then
  94.       MSR.LowMsg := KeyToWord(Key)
  95.     else
  96.       MSR.LowMsg := 0;
  97.     Key := WordToKey(65535);
  98.     PrevDiffBtreeKey(MsgFile, MsgNumberKey, RefNr, Key);
  99.     if (IsamOk) then
  100.       TempHigh := KeyToWord(Key)
  101.     else
  102.       TempHigh := 0;
  103.     if (TempHigh > MSR.HighMsg) then
  104.       MSR.HighMsg := TempHigh;
  105.     PutMsgStatusRec(MSR);
  106.     if (LockStatus) then
  107.       UnLockBtree(dbMsg);
  108.   end;
  109.  
  110.  
  111.   procedure DeleteMsgPrim(MsgHeaderRec : MsgHeaderType; RefNr : LongInt);
  112.   var
  113.     F : File;
  114.     KeyNr : Byte;
  115.     Key : IsamKeyStr;
  116.  
  117.   begin
  118.     if (MsgHeaderRec.AttachFileName <> '') then
  119.       begin
  120.         Assign(F, Cfig.MsgAttachPath+MsgHeaderRec.AttachFileName);
  121.         Erase(F);
  122.         if (IoResult <> 0) then
  123.           NoteError('Unable to delete message attachment '+MsgHeaderRec.AttachFileName);
  124.       end;
  125.     for KeyNr := MsgNumberKey to MsgDeleteKey do
  126.       begin
  127.         Key := BuildMsgKey(MsgHeaderRec, KeyNr);
  128.         if (Key <> '') then
  129.           begin
  130.             BtDeleteKey(MsgFile, KeyNr, RefNr, Key);
  131.             if (not IsamOk) then
  132.               LogFatalError(emDeleteMsgKey, IsamError);
  133.           end;
  134.       end;
  135.     BtDeleteVariableRec(MsgFile, RefNr);
  136.     if (not IsamOk) then
  137.       LogFatalError(emDeleteMsgRec, IsamError);
  138.   end;
  139.  
  140.  
  141.   procedure PurgeFirstMessage;
  142.   var
  143.     RecSize : Word;
  144.     Found : Boolean;
  145.     RefNr : LongInt;
  146.     Key : IsamKeyStr;
  147.     MsgHeaderRec : MsgHeaderType;
  148.  
  149.   begin
  150.     Found := False;
  151.     ClearBtreeKey(MsgFile, MsgNumberKey);
  152.     while (IsamOk) and (not Found) do
  153.       begin
  154.         NextBtreeKey(MsgFile, RefNr, Key, MsgNumberKey);
  155.         if (IsamOk) then
  156.           begin
  157.             RecSize := SizeOf(MsgHeaderType);
  158.             BtGetVariableRecPart(MsgFile, RefNr, MsgHeaderRec, RecSize);
  159.           end;
  160.         if (IsamOk) and (not FlagIsSet(MsgHeaderRec.MsgFlags, mfNoDelete)) then
  161.           begin
  162.             Found := True;
  163.             DeleteMsgPrim(MsgHeaderRec, RefNr);
  164.           end;
  165.       end;
  166.   end;
  167.  
  168.  
  169.   procedure AddMsgRec(var MsgRec : MsgRecType);
  170.   var
  171.     KeyNr : Byte;
  172.     RefNr : LongInt;
  173.     Key : IsamKeyStr;
  174.     MSR : MsgStatusRec;
  175.     AddedOk, LockStatus : Boolean;
  176.  
  177.   begin
  178.     AddedOk := False;
  179.     LockStatus := LockBTree(dbMsg);
  180.     ReCalcMsgStatus;
  181.     GetMsgStatusRec(MSR);
  182.     if (MSR.HighMsg = 65535) then
  183.       SendLine('Unable to save, message database is full.')
  184.     else
  185.       begin
  186.         if (ConfDesc.MaxMessages > 0) then
  187.           if (BtreeUsedKeys(MsgFile, MsgNumberKey) >= ConfDesc.MaxMessages) then
  188.             PurgeFirstMessage;
  189.         MsgRec.MsgNumber := Succ(MSR.HighMsg);
  190.         if (not FlagIsSet(MsgRec.MsgFlags, mfReceived)) then
  191.           begin
  192.             MsgRec.ReadTime.D := BadDate;
  193.             MsgRec.ReadTime.T := BadTime;
  194.           end;
  195.         BtFindKey(MsgFile, MsgNumberKey, RefNr, BuildMsgKey(MsgRec, MsgNumberKey));
  196.         if (not IsamOk) then
  197.           begin
  198.             BtAddVariableRec(MsgFile, RefNr, MsgRec, SizeOf(MsgHeaderType)+MsgRec.MsgBytes);
  199.             if (not IsamOk) then
  200.               LogFatalError('Error adding message in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
  201.             for KeyNr := MsgNumberKey to MsgDeleteKey do
  202.               begin
  203.                 Key := BuildMsgKey(MsgRec, KeyNr);
  204.                 if (Key <> '') then
  205.                   begin
  206.                     BTAddKey(MsgFile, KeyNr, RefNr, Key);
  207.                     if (not IsamOk) then
  208.                       LogFatalError('Error adding key in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
  209.                   end;
  210.               end;
  211.           end;
  212.         ReCalcMsgStatus;
  213.         AddedOk := True;
  214.       end;
  215.     if (LockStatus) then
  216.       UnLockBtree(dbMsg);
  217.     if (AddedOk) then
  218.       begin
  219.         ReadMInfo(True);
  220.         Inc(MInfo.TotalMessages);
  221.         Inc(MInfo.TempMsgs);
  222.         WriteMInfo;
  223.         SetUserHasMail(MsgRec.To_, ConfDesc.ConfNumber);
  224.       end;
  225.   end;
  226.  
  227.  
  228.   procedure UpdateMsgRec(var MsgRec : MsgRecType);
  229.   var
  230.     KeyNr : Byte;
  231.     RecSize : Word;
  232.     RefNr : LongInt;
  233.     Key : IsamKeyStr;
  234.     LockStatus : Boolean;
  235.     OldMsgHeader : MsgHeaderType;
  236.  
  237.   begin
  238.     LockStatus := LockBtree(dbMsg);
  239.     FindBtreeKey(MsgFile, RefNr, BuildMsgKey(MsgRec, MsgNumberKey), MsgNumberKey);
  240.     if (IsamOk) then
  241.       begin
  242.         RecSize := SizeOf(OldMsgHeader);
  243.         BtGetVariableRecPart(MsgFile, RefNr, OldMsgHeader, RecSize);
  244.         if (not IsamOk) then
  245.           LogFatalError('Error reading message in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
  246.         for KeyNr := MsgNumberKey to MsgDeleteKey do
  247.           begin
  248.             Key := BuildMsgKey(OldMsgHeader, KeyNr);
  249.             if (Key <> '') and (Key <> BuildMsgKey(MsgRec, KeyNr)) then
  250.               begin
  251.                 BtDeleteKey(MsgFile, KeyNr, RefNr, Key);
  252.                 if (not IsamOk) then
  253.                   LogFatalError('Error deleting message key in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
  254.               end;
  255.           end;
  256.         BtPutVariableRec(MsgFile, RefNr, MsgRec, SizeOf(MsgHeaderType)+MsgRec.MsgBytes);
  257.         if (not IsamOk) then
  258.           LogFatalError('Error writing message in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
  259.         for KeyNr := MsgNumberKey to MsgDeleteKey do
  260.           begin
  261.             Key := BuildMsgKey(MsgRec, KeyNr);
  262.             if (Key <> '') and (Key <> BuildMsgKey(OldMsgHeader, KeyNr)) then
  263.               begin
  264.                 BtAddKey(MsgFile, KeyNr, RefNr, Key);
  265.                 if (not IsamOk) then
  266.                   LogFatalError('Error adding message key in conference '+Long2Str(ConfDesc.ConfNumber), IsamError);
  267.               end;
  268.           end;
  269.       end;
  270.     if (LockStatus) then
  271.       UnLockBtree(dbMsg);
  272.   end;
  273.